home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Editors / emacs / Emacs-1.14b1 / lisp / think-c / tc-send.el < prev    next >
Encoding:
Text File  |  1994-05-31  |  10.8 KB  |  330 lines  |  [TEXT/EMAC]

  1. ;;;
  2. ;;; Code to send Apple events to Think C
  3. ;;;
  4.  
  5. ;;; Used when sending kRun events
  6. (defvar tc:use-debugger nil)
  7.  
  8. ;;; Used when sending kMake events
  9. (defvar tc:quick-scan t "*When nil, turn off quick scan for Make.")
  10.  
  11. (defmacro create-think-c-apple-event (eventClass eventID event transactionID)
  12.   (list 'ae-create-apple-event "KAHL" eventClass eventID event transactionID))
  13.  
  14. (defun tc:send-event (event)
  15.   (let* ((reply (make-string sizeof-AppleEvent 0))
  16.          (err (AESend event reply (+ kAEQueueReply kAENeverInteract)
  17.                       kAENormalPriority 0 0 0)))
  18.     (if (not (zerop err))
  19.         err
  20.       reply)))
  21.  
  22. (defun tc:open-file (file)
  23.   (let* (event
  24.          (reply (make-string sizeof-AppleEvent 0))
  25.          spec
  26.          transactionID
  27.          (result
  28.           (catch 'panic
  29.             (throw-err (create-think-c-apple-event kCoreEventClass kAEOpenDocuments
  30.                                                    event transactionID))
  31.             (throw-err (unix-filename-to-FSSpec file spec))
  32.             (throw-err (AEPutParamPtr event keyDirectObject typeFSS spec (length spec)))
  33.             (throw-err (AESend event reply (+ kAENoReply kAENeverInteract)
  34.                                kAENormalPriority 0 0 0))
  35.             noErr)))
  36.     (if event (AEDisposeDesc event))
  37.     result))
  38.  
  39. (defun tc:run ()
  40.   (let* (event
  41.          (reply (make-string sizeof-AppleEvent 0))
  42.          transactionID
  43.          (result
  44.           (catch 'panic
  45.             (throw-err (create-think-c-apple-event kAEThinkSuite kAERun
  46.                                                    event transactionID))
  47.             (throw-err (AEPutParamPtr event keyUpdateOptions typeEnumerated kAEYes 4))
  48.             (throw-err (AEPutParamPtr event keyAESaveOptions typeEnumerated kAEYes 4))
  49.             (throw-err (AEPutParamPtr event keyUseDebugger typeBoolean
  50.                                       (make-string 1 (if tc:use-debugger 1 0)) 1))
  51.             (throw-err (AEPutParamPtr event keyGo typeBoolean (make-string 1 1) 1))
  52.             (throw-err (AESend event reply (+ kAEQueueReply kAENeverInteract)
  53.                                kAENormalPriority 0 0 0))
  54.             (setq ae-history (cons (cons transactionID
  55.                                          (list (cons 'description "run")
  56.                                                (cons 'handler 'do-simple-reply)))
  57.                                    ae-history))
  58.             noErr)))
  59.     
  60.     (if event (AEDisposeDesc event))
  61.     result))
  62.  
  63. (defun tc:open-project (file)
  64.   (let* (event
  65.          spec
  66.          (reply (make-string sizeof-AppleEvent 0))
  67.          actualSize
  68.          transactionID
  69.          (result
  70.           (catch 'panic
  71.             (throw-err (create-think-c-apple-event kCoreEventClass kAEOpen
  72.                                                    event transactionID))
  73.             (throw-err (unix-filename-to-FSSpec file spec))
  74.             (throw-err (AEPutParamPtr event keyDirectObject typeFSS spec (length spec)))
  75.             (throw-err (AESend event reply (+ kAEQueueReply kAENeverInteract)
  76.                                kAENormalPriority 0 0 0))
  77.             (setq ae-history
  78.                   (cons (cons transactionID
  79.                               (list (cons 'description (concat "open-project " file))
  80.                                     (cons 'handler 'do-simple-reply)))
  81.                         ae-history))
  82.             noErr)))
  83.     
  84.     (if event (AEDisposeDesc event))
  85.     result))
  86.  
  87. (defun tc:close-project ()
  88.   (let* ((null-desc (make-string sizeof-AEDesc 0))
  89.          have-null-desc
  90.          (proj-desc (make-string sizeof-AEDesc 0))
  91.          have-proj-desc
  92.          (proj-obj (make-string sizeof-AEDesc 0))
  93.          have-proj-obj
  94.          event
  95.          (reply (make-string sizeof-AppleEvent 0))
  96.          actualSize
  97.          transactionID
  98.          (one (encode-long-integer 1))
  99.          (result
  100.           (catch 'panic
  101.             (throw-err (create-think-c-apple-event kCoreEventClass kAEClose
  102.                                                    event transactionID))
  103.             (throw-err (AECreateDesc typeNull "" 0 null-desc))
  104.             (setq have-null-desc t)
  105.             (throw-err (AECreateDesc typeLongInteger one (length one) proj-desc))
  106.             (setq have-proj-desc t)
  107.             (throw-err (CreateObjSpecifier cProjectDocument null-desc formAbsolutePosition
  108.                                            proj-desc 0 proj-obj))
  109.             (setq have-proj-obj t)
  110.             (throw-err (AEPutParamDesc event keyDirectObject proj-obj))
  111.             
  112.             (throw-err (AESend event reply (+ kAEQueueReply kAENeverInteract)
  113.                                kAENormalPriority 0 0 0))
  114.             
  115.             (setq ae-history
  116.                   (cons (cons transactionID (list (cons 'description "close-project")
  117.                                                   (cons 'handler 'do-simple-reply)))
  118.                         ae-history))
  119.             noErr)))
  120.     
  121.     (if have-null-desc (AEDisposeDesc null-desc))
  122.     (if have-proj-desc (AEDisposeDesc proj-desc))
  123.     (if have-proj-obj (AEDisposeDesc proj-obj))
  124.     (if event (AEDisposeDesc event))
  125.     result))
  126.  
  127. (defun tc:build-application (appname)
  128.   (let* ((null-desc (make-string sizeof-AEDesc 0))
  129.          have-null-desc
  130.          (proj-obj (make-string sizeof-AEDesc 0))
  131.          have-proj-obj
  132.          (proj-desc (make-string sizeof-AEDesc 0))
  133.          have-proj-desc
  134.          event
  135.          (reply (make-string sizeof-AppleEvent 0))
  136.          actualSize
  137.          transactionID
  138.          spec
  139.          (one (encode-long-integer 1))
  140.          (result
  141.           (catch 'panic
  142.             (throw-err (create-think-c-apple-event kAECoreSuite kAESave
  143.                                                    event transactionID))
  144.             
  145.             (throw-err (AECreateDesc typeNull "" 0 null-desc))
  146.             (setq have-null-desc t)
  147.             (throw-err (AECreateDesc typeLongInteger one (length one) proj-desc))
  148.             (setq have-proj-desc t)
  149.             (throw-err (CreateObjSpecifier cProjectDocument null-desc formAbsolutePosition
  150.                                            proj-desc 0 proj-obj))
  151.             (setq have-proj-obj t)
  152.             (throw-err (AEPutParamDesc event keyDirectObject proj-obj))
  153.             
  154.             (let ((err (unix-filename-to-FSSpec appname spec)))
  155.               (if (and (not (zerop err)) (not (= err fnfErr))) (throw 'panic err)))
  156.             (throw-err (AEPutParamPtr event keyAEFile typeFSS spec (length spec)))
  157.             (throw-err (AEPutParamPtr event keyAEFileType typeType kProjectType 4))
  158.             (throw-err (AEPutParamPtr event keySaveFlags typeLongInteger one (length one)))
  159.             
  160.             (throw-err (AESend event reply (+ kAEQueueReply kAENeverInteract)
  161.                                kAENormalPriority 0 0 0))
  162.             
  163.             (setq ae-history
  164.                   (cons (cons transactionID
  165.                               (list (cons 'description (concat "build-application " appname))
  166.                                     (cons 'handler 'tc:do-build-reply)))
  167.                         ae-history))
  168.             noErr)))
  169.     
  170.     (if have-null-desc (AEDisposeDesc null-desc))
  171.     (if have-proj-desc (AEDisposeDesc proj-desc))
  172.     (if have-proj-obj (AEDisposeDesc proj-obj))
  173.     (if event (AEDisposeDesc event))
  174.     result))
  175.  
  176. (defun tc:make ()
  177.   (let* ((null-desc (make-string sizeof-AEDesc 0))
  178.          have-null-desc
  179.          (file-desc (make-string sizeof-AEDesc 0))
  180.          have-file-desc
  181.          (file-obj (make-string sizeof-AEDesc 0))
  182.          have-file-obj
  183.          (reply (make-string sizeof-AppleEvent 0))
  184.          event
  185.          resultType
  186.          transactionID
  187.          actualSize
  188.          (flags (encode-long-integer (+ (if tc:quick-scan 2 0) 4)))
  189.          (one (encode-long-integer 1))
  190.          (result
  191.           (catch 'panic
  192.             (throw-err (create-think-c-apple-event kAEThinkSuite kMake
  193.                                                    event transactionID))
  194.             
  195.             (throw-err (AECreateDesc typeNull "" 0 null-desc))
  196.             (setq have-null-desc t)
  197.             (throw-err (AECreateDesc typeLongInteger one (length one) file-desc))
  198.             (setq have-file-desc t)
  199.             (throw-err (CreateObjSpecifier cProjectDocument null-desc formAbsolutePosition
  200.                                            file-desc 0 file-obj))
  201.             (setq have-file-obj t)
  202.             (throw-err (AEPutParamDesc event keyDirectObject file-obj))
  203.             (throw-err (AEPutParamPtr event keyCompileFlags typeLongInteger
  204.                                       flags (length flags)))
  205.             
  206.             (throw-err (AESend event reply (+ kAEQueueReply kAENeverInteract)
  207.                                kAENormalPriority 0 0 0))
  208.             
  209.             (setq ae-history (cons (cons transactionID
  210.                                          (list (cons 'description "make")
  211.                                                (cons 'handler 'tc:do-compile-reply)
  212.                                                (cons 'flavor kMake)))
  213.                                    ae-history))
  214.             noErr)))
  215.     
  216.     (if have-null-desc (AEDisposeDesc null-desc))
  217.     (if have-file-desc (AEDisposeDesc file-desc))
  218.     (if have-file-obj (AEDisposeDesc file-obj))
  219.     (if event (AEDisposeDesc event))
  220.     result))
  221.  
  222. (defun tc:compile-file-internal (file operation)
  223.   (let* ((null-desc (make-string sizeof-AEDesc 0))
  224.          have-null-desc
  225.          (file-desc (make-string sizeof-AEDesc 0))
  226.          have-file-desc
  227.          (file-obj (make-string sizeof-AEDesc 0))
  228.          have-file-obj
  229.          reply
  230.          event
  231.          resultType
  232.          transactionID
  233.          actualSize
  234.          (flags (encode-long-integer 32))
  235.          (result
  236.           (catch 'panic
  237.             (throw-err (create-think-c-apple-event kAEThinkSuite operation
  238.                                                    event transactionID))
  239.             
  240.             (throw-err (AECreateDesc typeNull "" 0 null-desc))
  241.             (setq have-null-desc t)
  242.             (throw-err (AECreateDesc typeChar file (length file) file-desc))
  243.             (setq have-file-desc t)
  244.             (throw-err (CreateObjSpecifier cSourceFile null-desc formName
  245.                                            file-desc 0 file-obj))
  246.             (setq have-file-obj t)
  247.             (throw-err (AEPutParamDesc event keyDirectObject file-obj))
  248.             
  249.             (if (or (equal operation kDisassemble)
  250.                     (equal operation kPreprocess))
  251.                 (throw-err
  252.                  (AEPutParamPtr event keyCompileFlags typeLongInteger flags (length flags))))
  253.             
  254.             (setq reply (tc:send-event event))
  255.             (if (integerp reply) (throw 'panic reply))            
  256.             (setq ae-history
  257.                   (cons (cons transactionID
  258.                               (list
  259.                                (cons 'description
  260.                                      (concat
  261.                                       (cdr (assoc operation
  262.                                                   (list (cons kCompile "compile")
  263.                                                         (cons kCheckSyntax "check-syntax")
  264.                                                         (cons kPreprocess "preprocess")
  265.                                                         (cons kDisassemble "disassemble"))))
  266.                                       " " file))
  267.                                (cons 'handler 'tc:do-compile-reply)
  268.                                (cons 'flavor operation)))
  269.                         ae-history))
  270.             (tc:launch-tpm) ;;; We'll bring TPM to the front here.
  271.             noErr)))
  272.     
  273.     (if have-null-desc (AEDisposeDesc null-desc))
  274.     (if have-file-desc (AEDisposeDesc file-desc))
  275.     (if have-file-obj (AEDisposeDesc file-obj))
  276.     (if event (AEDisposeDesc event))
  277.     result))
  278.  
  279. (defun tc:compile-file (filename)
  280.   (tc:compile-file-internal filename kCompile))
  281.  
  282. (defun tc:check-syntax (filename)
  283.   (tc:compile-file-internal filename kCheckSyntax))
  284.  
  285. (defun tc:disassemble (filename)
  286.   (tc:compile-file-internal filename kDisassemble))
  287.  
  288. (defun tc:preprocess (filename)
  289.   (tc:compile-file-internal filename kPreprocess))
  290.  
  291. (defun tc:remove-objects ()
  292.   (let* (event
  293.          (null-desc (make-string sizeof-AEDesc 0))
  294.          have-null-desc
  295.          (objcode-desc (make-string sizeof-AEDesc 0))
  296.          have-objcode-desc
  297.          (objcode-obj (make-string sizeof-AEDesc 0))
  298.          have-object-obj
  299.          (reply (make-string sizeof-AppleEvent 0))
  300.          actualSize
  301.          transactionID
  302.          (one (encode-long-integer 1))
  303.          (result
  304.           (catch 'panic
  305.             (throw-err (create-think-c-apple-event kAECoreSuite kAEDelete
  306.                                                    event transactionID))
  307.             (throw-err (AECreateDesc typeNull "" 0 null-desc))
  308.             (setq have-null-desc t)
  309.             (throw-err (AECreateDesc typeLongInteger one (length one) objcode-desc))
  310.             (setq have-objcode-desc t)
  311.             (throw-err (CreateObjSpecifier cObjectCode null-desc formAbsolutePosition
  312.                                            objcode-desc 0 objcode-obj))
  313.             (setq have-objcode-obj t)
  314.             (throw-err (AEPutParamDesc event keyDirectObject objcode-obj))
  315.             
  316.             (throw-err (AESend event reply (+ kAEQueueReply kAENeverInteract)
  317.                                kAENormalPriority 0 0 0))
  318.             
  319.             (setq ae-history (cons (cons transactionID
  320.                                          (list (cons 'description "remove-objects")
  321.                                                (cons 'handler 'do-simple-reply)))
  322.                                    ae-history))
  323.             noErr)))
  324.     
  325.     (if event (AEDisposeDesc event))
  326.     (if have-objcode-desc (AEDisposeDesc objcode-desc))
  327.     (if have-objcode-obj (AEDisposeDesc objcode-obj))
  328.     (if have-null-desc (AEDisposeDesc null-desc))
  329.     result))
  330.